home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / RUNACTD.PRG < prev    next >
Encoding:
Text File  |  1998-05-26  |  8.3 KB  |  343 lines
  1. * _RUNACTIVEDOC
  2. * Runs Activedocument menu item from Tools menu.
  3.  
  4.  
  5. #DEFINE C_NOTACTDOC_LOC    "The following file is not a Visual FoxPro Active Document: "
  6. #DEFINE C_NOFILE_LOC    "The following file does not exist: "
  7. #DEFINE C_CAPTION_LOC    "Run Active Document"
  8. #DEFINE C_RUNOPTIONS_LOC    "In Browser,Stand Alone,In Browser (Debugging),Stand Alone (Debugging)"
  9. #DEFINE C_RUNBTN_LOC    "\<Run"
  10. #DEFINE C_CANCELBTN_LOC    "Cancel"
  11. #DEFINE C_ENTERFILENAME_LOC    "Please enter a filename."
  12. #DEFINE C_BADMODE_LOC    "Incorrect Mode Value"
  13. #DEFINE    C_BADFILENAME_LOC    "Invalid Active Document file selected."
  14. #DEFINE    ACTIVEDOC_EXTN    "APP"
  15. #DEFINE RESFILE_ID    "ADOCFILES"
  16. #DEFINE CRLF    CHR(13)+CHR(10)
  17. #DEFINE HADERROR_LOC    "An error occurred in Active Document launcher."
  18. #DEFINE ERROR1_LOC        "Error number: "
  19. #DEFINE ERROR2_LOC        "Error method: "
  20. #DEFINE ERROR3_LOC        "Error line: "
  21.  
  22. LPARAMETERS cFilename, nMethod
  23. LOCAL oForm
  24. oForm = CREATEOBJECT('myForm',cFileName,nMethod)
  25. oForm.Show(1)
  26. RETURN
  27.  
  28. DEFINE CLASS myform AS Form
  29.     AutoCenter = .T. 
  30.     BorderStyle = 2
  31.     Caption = C_CAPTION_LOC
  32.     MinButton = .F.
  33.     MaxButton = .F.
  34.     Height = 106
  35.     Width = 384
  36.     HelpContextID = 229996600
  37.  
  38.     ADD OBJECT lblDoc AS Label WITH ;
  39.         Height = 23 ,;
  40.         Left = 12 ,;
  41.         Top = 12 ,;
  42.         Width = 252,;
  43.         Caption = "Active Document:"
  44.  
  45.     ADD OBJECT lblHost AS Label WITH ;
  46.         Height = 23 ,;
  47.         Left = 12 ,;
  48.         Top = 56 ,;
  49.         Width = 252,;
  50.         Caption = "Hosting:"
  51.  
  52.     ADD OBJECT cboADocs AS ComboBox WITH ;
  53.         Height = 21 ,;
  54.         Left = 12 ,;
  55.         Top = 28 ,;
  56.         Width = 252,;
  57.         InputMask = REPLICATE("X",255)
  58.         
  59.     ADD OBJECT cmdGetFile AS CommandButton WITH ;
  60.         Caption = '...' ,;
  61.         Height = 23 ,;
  62.         Left = 268 ,;
  63.         Top = 28 ,;
  64.         Width = 22
  65.         
  66.     ADD OBJECT cboMode AS ComboBox WITH ;
  67.         Height = 21 ,;
  68.         Left = 12 ,;
  69.         RowSource = C_RUNOPTIONS_LOC ,;
  70.         RowSourceType = 1 ,;
  71.         Style = 2 ,;
  72.         Top = 72 ,;
  73.         Width = 280
  74.         
  75.     ADD OBJECT cmdRun AS CommandButton WITH ;
  76.         Caption = C_RUNBTN_LOC ,;
  77.         Default = .T. ,;
  78.         Height = 23 ,;
  79.         Left = 300 ,;
  80.         Top = 28 ,;
  81.         Width = 72 
  82.     
  83.     ADD OBJECT cmdCancel AS CommandButton WITH ;
  84.         Cancel = .T. ,;
  85.         Caption = C_CANCELBTN_LOC ,;
  86.         Height = 23 ,;
  87.         Left = 300 ,;
  88.         Top = 57 ,;
  89.         Width = 72
  90.         
  91.     ADD OBJECT hyperLink AS HyperLink
  92.     
  93.     PROCEDURE Init
  94.         LPARAMETERS cFilename, nMode
  95.         
  96.         IF PARAMETERS() < 2
  97.             nMode = 1
  98.         ENDIF
  99.  
  100.         IF PARAMETERS() < 1
  101.             cFilename = ""
  102.         ENDIF
  103.  
  104.         IF VARTYPE(cFileName) # 'C'
  105.             cFileName = ""
  106.         ENDIF
  107.  
  108.         IF VARTYPE(nMode) # 'N' OR nMode < 1 OR nMode > 4
  109.             nMode= 1
  110.         ENDIF
  111.  
  112.         this.cboADocs.Value = cFileName
  113.         this.cboMode.Value = nMode
  114.         THIS.GetPref()
  115.         
  116.         IF  fontmetric(1, 'MS Sans Serif', 8, '') # 13 OR ;
  117.             fontmetric(4, 'MS Sans Serif', 8, '') # 2 OR ;
  118.             fontmetric(6, 'MS Sans Serif', 8, '') # 5 OR ;
  119.             fontmetric(7, 'MS Sans Serif', 8, '') # 11
  120.             this.setall('fontname', 'Arial')
  121.         ELSE
  122.             this.setall('fontname','MS Sans Serif')
  123.         ENDIF
  124.         this.setall('fontsize',8)
  125.     ENDPROC
  126.     
  127.     PROCEDURE Error
  128.         LPARAMETERS nError, cMethod, nLine
  129.         IF INLIST(nError,1705)    &&ignore certain errors and handle in method
  130.             RETURN
  131.         ENDIF
  132.         THIS.MSGBOX(HADERROR_LOC+CRLF+;
  133.                     ERROR1_LOC+TRANS(nError)+CRLF+;
  134.                     ERROR2_LOC+cMethod+CRLF+;
  135.                     ERROR3_LOC+TRANS(nLine))        
  136.     ENDPROC
  137.     
  138.     PROCEDURE MsgBox
  139.         LPARAMETERS cMsg
  140.         MessageBox(cMsg, thisform.Caption)
  141.     ENDPROC
  142.     
  143.     PROCEDURE cmdRun.Click
  144.         LOCAL lcFileName, nMethod, cCmd
  145.         lcFileName = ALLTRIM(thisform.cboADocs.Text)
  146.         IF EMPTY(lcFilename)
  147.             thisform.MsgBox(C_ENTERFILENAME_LOC)
  148.             thisform.cboADocs.SetFocus
  149.             RETURN
  150.         ENDIF
  151.         lcFileName = FULLPATH(lcFileName)
  152.         IF NOT FILE(lcFilename)
  153.             thisform.MsgBox(C_NOFILE_LOC + lcFileName)
  154.             thisform.cboADocs.SetFocus
  155.             RETURN
  156.         ENDIF
  157.         IF UPPER(JUSTEXT(lcFileName)) # ACTIVEDOC_EXTN
  158.             thisform.MsgBox(C_NOTACTDOC_LOC + lcFileName)
  159.             thisform.cboADocs.SetFocus
  160.             RETURN        
  161.         ENDIF
  162.         nMethod = thisform.cboMode.Value
  163.         thisform.Hide()
  164.         thisform.SavePref()
  165.         DO CASE
  166.             CASE nMethod = 1    && runtime, hosted in browser
  167.                 thisform.hyperLink.NavigateTo(lcFilename)
  168.                 
  169.             CASE nMethod = 2    && runtime, stand alone
  170.                 thisform.Shelldoc(lcFileName)
  171.                 
  172.             CASE nMethod = 3    && ide, hosted in browser
  173.                 CLOSE ALL
  174.                 SYS(4204)
  175.                 thisform.hyperLink.NavigateTo(lcFilename)
  176.                 
  177.             CASE nMethod = 4    && ide, stand alone
  178.                 DO (lcFilename)
  179.                 
  180.             OTHERWISE
  181.                 ASSERT(C_BADMODE_LOC)
  182.         ENDCASE
  183.         thisform.release    
  184.     ENDPROC
  185.     
  186.     PROCEDURE cmdCancel.Click
  187.         thisform.release
  188.     ENDPROC
  189.             
  190.     PROCEDURE cmdGetFile.Click
  191.         LOCAL lcFile,i
  192.         lcFile = GETFILE(ACTIVEDOC_EXTN)
  193.         IF EMPTY(lcFile)
  194.             RETURN
  195.         ENDIF
  196.  
  197.         IF FILE(lcFile) AND UPPER(JUSTEXT(lcFile))=ACTIVEDOC_EXTN
  198.             FOR i = 1 TO thisform.cboADocs.ListCount
  199.                 IF LOWER(ALLTRIM(lcFile)) == LOWER(ALLTRIM(thisform.cboADocs.List[m.i]))
  200.                     thisform.cboADocs.Value = LOWER(lcFile)
  201.                     RETURN
  202.                 ENDIF
  203.             ENDFOR
  204.             thisform.cboADocs.AddItem(LOWER(IIF(LEFT(lcFile,1)="\","\","")+lcFile))
  205.             thisform.cboADocs.Value = LOWER(lcFile)
  206.         ELSE
  207.             thisform.MsgBox(C_BADFILENAME_LOC)
  208.         ENDIF
  209.     ENDPROC
  210.  
  211.     PROCEDURE shelldoc(tcFileName)
  212.         LOCAL lcFileName
  213.         IF EMPTY(tcFileName)
  214.             RETURN -1
  215.         ENDIF
  216.         lcFileName=ALLTRIM(tcFileName)
  217.         DECLARE INTEGER ShellExecute ;
  218.                 IN SHELL32.DLL ;
  219.                 INTEGER nWinHandle,;
  220.                 STRING cOperation,;   
  221.                 STRING cFileName,;
  222.                 STRING cParameters,;
  223.                 STRING cDirectory,;
  224.                 INTEGER nShowWindow
  225.         RETURN ShellExecute(0,"run",lcFilename,"","",1)
  226.     ENDPROC
  227.     
  228.     PROCEDURE OpenResFile
  229.         LOCAL lnSaveArea
  230.         lnSaveArea=SELECT()
  231.         IF !FILE(SYS(2005))    && resource file not found.
  232.            RETURN .F.
  233.         ENDIF
  234.         SELECT 0
  235.         USE (SYS(2005)) AGAIN SHARED
  236.         IF EMPTY(ALIAS())
  237.             SELECT (lnSaveArea)
  238.             RETURN .F.
  239.         ENDIF
  240.     ENDPROC
  241.     
  242.     PROCEDURE GetPref
  243.         * Read preferences from resource file
  244.         LOCAL lnSaveArea,lnMemwidth,i
  245.         lnSaveArea=SELECT()
  246.         lnMemwidth = SET('MEMOWIDTH')
  247.         SET MEMOWIDTH TO 255
  248.         IF !THIS.OpenResFile()
  249.             RETURN
  250.         ENDIF
  251.         LOCATE FOR UPPER(ALLTRIM(type)) == "PREFW";
  252.                AND UPPER(ALLTRIM(id)) == RESFILE_ID;
  253.                AND !DELETED()
  254.  
  255.         IF FOUND() AND !EMPTY(data) AND ;
  256.           ckval=VAL(SYS(2007,data))
  257.             RESTORE FROM MEMO data ADDITIVE
  258.             IF TYPE("vfp_Save_aDocFiles[1]")="C"
  259.                 FOR i = 1 TO ALEN(vfp_Save_aDocFiles)
  260.                     IF FILE(vfp_Save_aDocFiles[m.i])
  261.                         THIS.cboADocs.AddItem(IIF(LEFT(vfp_Save_aDocFiles[m.i],1)="\","\","")+vfp_Save_aDocFiles[m.i])
  262.                     ENDIF
  263.                 ENDFOR
  264.                 IF THIS.cboADocs.ListCount#0
  265.                     THIS.cboADocs.Value = THIS.cboADocs.List[1]
  266.                 ENDIF
  267.             ENDIF
  268.         ENDIF
  269.         USE
  270.         SELECT (lnSaveArea)
  271.         SET MEMOWIDTH TO lnMemwidth
  272.     ENDPROC
  273.     
  274.     PROCEDURE SavePref
  275.         * Record user preferences in the resource file
  276.  
  277.         LOCAL filarray, filpos, fileattr, lnSaveArea, i, lnLen
  278.         lnSaveArea = SELECT()
  279.  
  280.         IF !FILE(SYS(2005))    && resource file not found.
  281.            RETURN .F.
  282.         ENDIF
  283.  
  284.         * Don't update if this is a read-only file
  285.         fileattr = ""
  286.         DIMENSION filarray[1]   && resized automatically by ADIR()
  287.         IF ADIR(filarray,SYS(2005)) > 0
  288.            filpos = ASCAN(filarray,JUSTFNAME(SYS(2005)))
  289.            IF m.filpos > 0
  290.               fileattr = filarray[m.filpos,5]
  291.            ENDIF
  292.         ENDIF
  293.         IF ATC("R",m.fileattr)#0
  294.            RETURN .F.
  295.         ENDIF
  296.  
  297.         IF !THIS.OpenResFile()
  298.             RETURN .F.
  299.         ENDIF
  300.  
  301.         IF IsReadonly()
  302.             USE
  303.             SELECT (lnSaveArea)
  304.             RETURN .f.
  305.         ENDIF
  306.  
  307.         DIMENSION vfp_Save_aDocFiles[1]
  308.         vfp_Save_aDocFiles[1]=ALLTRIM(THIS.cboADocs.Value)
  309.         FOR i = 1 TO THIS.cboADocs.ListCount
  310.             IF !(ALLTRIM(THIS.cboADocs.List[m.i])==ALLTRIM(THIS.cboADocs.Value))
  311.                 lnLen = ALEN[vfp_Save_aDocFiles]
  312.                 DIMENSION vfp_Save_aDocFiles[lnLen+1]
  313.                 vfp_Save_aDocFiles[lnLen+1] = THIS.cboADocs.List[m.i]
  314.             ENDIF
  315.         ENDFOR
  316.  
  317.         LOCATE FOR UPPER(ALLTRIM(type)) == "PREFW" ;
  318.            AND UPPER(ALLTRIM(id)) == RESFILE_ID
  319.     
  320.         IF !FOUND()
  321.            APPEND BLANK
  322.            SAVE TO MEMO data ALL LIKE vfp_Save_aDocFiles
  323.            REPLACE type     WITH "PREFW",;
  324.                    id       WITH RESFILE_ID,;
  325.                    ckval    WITH VAL(SYS(2007,data)),;
  326.                    updated  WITH DATE(),;
  327.                    readonly WITH .F.
  328.         ELSE
  329.            IF readonly   && resource *record* (not file) is read-only
  330.               USE
  331.               SELECT (lnSaveArea)
  332.               RETURN .F.
  333.            ELSE
  334.               SAVE TO MEMO data ALL LIKE vfp_Save_aDocFiles
  335.               REPLACE ckval WITH VAL(SYS(2007,data))
  336.            ENDIF
  337.         ENDIF
  338.         USE
  339.         SELECT (lnSaveArea)
  340.         RETURN .T.
  341.     ENDPROC
  342. ENDDEFINE
  343.